TITLE	PLAY MUSIC FILES ON THE DAC
	SUBTTL	DEFINITIONS
;MODIFIED FOR KI 7-APR-76 BY JIM LAWSON
	ENTRY PLAY
	VERNO==↑d8

; FEATURE TEST SWITCHES

ifndef ftfsub,< ftfsub==0 ; 1 for FORTRAN callable subroutine support>
IFNDEF FTMT,<	FTMT==0	; 1 FOR MAG-TAPE SUPPORT>
IFNDEF FTKSYS,<	FTKSYS==0	; 1 FOR TRPSET SUPPORT>
IFNDEF FT12B,<	FT12B==1	; 1 FOR OLD DAC (12 - BITS)>
IFNDEF FT16B,<	FT16B==1	; 1 FOR NEW DAC (16 - BITS)>

ifn ftfsub,<
	ftseg==0
	ftmt==0
	ftksys==0		; don't allow ksys if we're a subroutine
	search formac(formac.unv[s,jrl])
	EXTERNAL CEXIT.,chnget,chnrel, pshint,popint, CORGET,CORREL
	.request CORFUN[DSP,JRL]
> ; end ifn ftfsub above

	define mesage (arg),<
if1,<
ifn ftfsub,<printx[Assembling FORTRAN callable PLAY subroutine version arg]>
ife ftfsub,<printx[Assembling PLASUB version arg]>
>>
	mesage (\verno)

	SEARCH JLMAC(JLMAC.UNV[S,JRL]),UJBDAT,UUOSYM,dpyuuo,macten

	EXTERNAL SBFILN
;;	EXTERNAL .HELPR,SBFILN

;THE FOLLOWING ARE IN "LIB.REL[S,JRL]"

	EXTERNAL PARSE,OCTSP,DECIDL,DECOUT,OCTOUT,SIXINA,TYDEV,TYSPEC
	
	.TEXT	%,/SEGMENT:LOW LIB[S,JRL]/SEARCH,SYS:HELPER%

	SUBTTL DAC DEFINITIONS

	DAC12=400	; DEVICE CODE FOR OLD DAC
	DAC16=404	; DEVICE CODE FOR NEW DAC
	DACPI==1	; DAC PI CHANNEL
	ON=1B31		;SAME AS BUSY
	OFF=0
	DONE=1B32
	BUSY=1B31
	MISS=1B30

; MACRO TO REMEMBER WHERE DEVICE CODE MUST BE SET.

	FTMDAC==FT12B&FT16B	; MULTIPLE DAC FLAG

	DEFINE .ODFB (ADD),<POINT 3,ADD,29>
	DEFINE .ODMB (ADD),<POINT 2,ADD,19>
	DEFINE .ODCB (ADD),<POINT 5,ADD,26>
	DEFINE .NDFB (ADD),<POINT 0,ADD,29>
	DEFINE .NDMB (ADD),<POINT 0,ADD,29>
	DEFINE .NDCB (ADD),<POINT 8,ADD,29>

	ifon FTMDAC,<
	DEFINE DACON,<	PUSHJ	P,@ONADD>
	DEFINE DACOFF,<	PUSHJ	P,@OFFADD>
	DEFINE DOFLT (ADD),<	DPB	T1,FLTPTR(P1)>
	DEFINE DOCHN (ADD),<	DPB	T1,CHNPTR(P1)>
	DEFINE DOCLK (ADD),<	DPB	T2,CLKPTR(P1)>
	DEFINE CONCLK,<	PUSHJ	P,@CONADD(P1)>
> ;END IFN FTMDAC ABOVE

	ifoff FTMDAC,<
	DEFINE DACON,<	XCT	CONOWD>
	DEFINE DACOFF,< CONO	DAC,OFF>

	ifon FT12B,< DAC = DAC12 
	.GDTYP==0
	DEFINE DOFLT (ADD),< 	DPB	T1,[.ODFB (ADD)]>
	DEFINE DOCHN (ADD),<	DPB	T1,[.ODMB (ADD)]>
	DEFINE DOCLK (ADD),<	DPB	T2,[.ODCB (ADD)]>
	DEFINE CONCLK,<	PUSHJ	P,OCLK>
> ; END IFN FT12B ABOVE
	list
	ifon FT16B,< DAC = DAC16 
	.GDTYP==1
	DEFINE DOFLT (ADD),<	DPB	T1,[.NDFB (ADD)]>
	DEFINE DOCHN (ADD),<	DPB	T1,[.NDMB (ADD)]>
	DEFINE DOCLK (ADD),<	DPB	T2,[.NDCB (ADD)]>
	DEFINE CONCLK,<	PUSHJ	P,NCLK>
> ; END IFN FT16B ABOVE
	list
>	; END IFE FTMDAC ABOVE
	list
	..NI==0

	DEFINE REMADD (LABL),< .IO$'LABL==. >

	DEFINE DACIO (IN,ADDR),<
	ifon FTMDAC,<
IF1,<	IFDEF ..IOP,<PRINTX \ALL DAC I/O INSTRUCTIONS MUST BE DEFINED PRIOR TO EXPANSION OF DODAC MACRO.\>>
	REMADD (\..NI)
	..NI==..NI+1
	IN	ADDR
>	; END IFN FTMDAC ABOVE
	ifoff FTMDAC,<
	IN	DAC,ADDR
>	; END IFE FTMDAC SBOVE
	list
>

	ifon FTMDAC,<
	DEFINE DEVPTR (LABL),<
	POINT	7,.IO$'LABL,9
>
	DEFINE DODAC,<
	..IOP==.
	..IOL==..NI
	..IOA==0
	REPEAT ..NI,<
	DEVPTR (\..IOA)
	..IOA==..IOA+1
>>
>	; END IFN FTMDAC ABOVE
	list
	SUBTTL CONSTANTS,ACS, AND FLAGS

	NUM=↑D100	;NUMBER OF 128 WORD BLOCKS PER BUFFER
	SIZE=↑D128*NUM	;TOTAL SIZE OF EACH BUFFER
	HEDLEN=200	;SIZE OF MUSIC FILE HEADER

; EXTRA AC DEFINITIONS

	T=1		;TEMP ACC
	I=2		;ACC TO HOLD RELOCATION FACTOR
	SETUP=4		;ACC USED FOR INITIAL SETUP
	DSK=5		;INPUT CHANNEL
	F=0		;AC FOR THE FOLLOWING FLAGS.

; locking code definition


;LEFT HALF FLAGS
	.UBLEW=400000	;USING DEFAULTS BECAUSE USER BLEW IT.
	ifon FTKSYS,<
	.KSYS=200000	;USER WANTS TIME-SHARING STOPPED.
>	; END IFN FTKSYS ABOVE

	ifon FTMT,<
	.REWMT=100000	;USER WANTS MAG-TAPE REWOUND.
	.MTDEV=040000	;INPUT DEVICE IS MAG-TAPE.
> ;END IFN FTMT ABOVE
	list
	.GTSWT=010000	;WE'VE DECODED A SWITCH
	.ONLYH=004000	;USER JUST WANTS TO SEE HEADER INFO. DON'T PLAY
	.FHEAD=002000	;FILE HAS A HEADER BLOCK.
;RIGHT HALF FLAGS

	ifon FTMT,<
	.ATEOF=020000	;MAG-TAPE IS AT EOF.
	.ATOBS=004000	;AUTO BACKSPACE SWITCH.
> ; END IFN FTMT ABOVE
	list
;LOCATIONS IN MUSIC FILE HEADER
	IDLOC==0
	CLOC==1
	PLOC==2
	CHNLOC==3
	AMPLOC==4
	TLOC==100
	SUBTTL STORAGE

	LOWSEG

	ifoff ftfsub,<
	LOC	.JBVER
	EXP	VERNO
	RELOC	0
> ; end ife ftfsub above
	list
HIOWD:	IOWD HEDLEN,HEADER
	Z
IBP1:	BLOCK	2		;IOWD FOR INITIAL DISK TRANSFER
BP1:	XWD	-SIZE,0	;IOWD FOR INPUT TRANSFERS
	Z
BP2:	XWD	-SIZE,0	;IOWD FOR INPUT TRANSFERS.
	Z
RBP1:	BLOCK	2	;RELOCATED IOWD FOR BF1.
RBP2:	BLOCK	2	;RELOCATED IOWD FOR BF2.
SLPTIM:	0		;TIME TO SLEEP WAITING FOR DAC.
TIOWD:	0		;VALUE OF dac IOWD WHEN WE CAN START REFILL.
LIOWD:	0		;LAST IOWD
diowd:	0		;IOWD FOR BLKO
OLDSIZ:	BLOCK	1	; SIZE BEFORE CORING UP FOR BUFFERS
PDL:	BLOCK 20

SSTINS:	SETSTS	DSK,.IODPR	; SET STATUS IN CASE OR ERRORS.
OSPEC:	UU.DEL!UU.DER!400!.IODPR 	; DISABLE ERROR LOGGING AND ERROR RETRY.
DEV:	SIXBIT	/DSKM/
	0

	ifon FTMT,<
MTPOS:	0			;MAG-TAPE POSITION COUNTER.
MTSPEC:	0			;BLOCK FOR MTCHR. UUO
	BLOCK	12
MTNFB:	0			;NO. OF FILES FROM BOT.
> ; END IFN FTMT ABOVE
	list
FILE:	SIXBIT	/MUSIC/
EXT:	SIXBIT	/MSB/


;EXTENDED LOOKUP BLOCK TO GET FILE LENGTH
EXLKUP:	EXP	NARGS
FILPPN:	0
FILNAM:	SIXBIT	/MUSIC/		;FILNAM GETS INFO FROM FILE ANYWAY!
FILEXT:	SIXBIT	/MSB/
FILPRV:	EXP	0
FILSIZ:	0

	NARGS==.-1-EXLKUP
MUSPPN:	0		;DEFAULT PPN

MYPPN:	0		;USER'S PPN
INDEX:	0		;SAVE RELOCATION FACTOR
MFLG:	0		;FLAG FOR DATA MISSED
DFLG:	0		;FLAG FOR DONE
	ifon FTKSYS,<
KILFLG:	0		;TIME-SHARING IS STOPPED FLAG.
> ; END IFN FTKSYS ABOVE
	list
TPOINT:	0		;NEXT IOWD FOR INTERRUPT ROUTINE
WHATBF:	0		;BUFFER POINTER -1=BUFFER 1, +1=BUFFER 2.

RUNHPQ:	0		;HIGHEST HIGH PRIORITY QUEUE AVAILABLE.
DSKHPQ:	XWD DSK,0	;HIGHEST DISK HIGH PRIORITY QUEUE.

INBF:	0		;START OF CHANNEL COMMAND LIST FOR INPUT.
	Z		;TERMINATES CHANNEL COMMAND LIST

; VARIABLES USED BY THE DACS.

DACSTT:	0		; DAC STATUS AS READ BY CONI

;POINTER TO DAC PARAMETERS TO BE USED FOR CURRENT CONVERSION.

	ifon FTMDAC,<
NSAMPW:	0		; NUMBER OF SAMPLES PER WORD IN FILE.
TYPE:	FTYPE		; POINTER TO LOCATION CONTAINING FILE TYPE
> ; END IFN FTMDAC ABOVE
	list
NCHNS:	FNCHNS		; POINTER TO LOCATION CONTAINING NUMBER OF CHANNELS
SRATE:	FSRATE		; POINTER TO WORD CONTAINING SAMPLING RATE
FILTR:	FFILTR		; POINTER TO WORD CONTAINING DEFAULT FILTER SETTINGS

;DAC PARAMETERS AS READ FROM FILE HEADER

	ifon FTMDAC,<
FTYPE:	0
> ; END IFN FTMDAC ABOVE
	list
FNCHNS:	1
FSRATE:	↑D10000
FFILTR:	2

	ifon ftfsub,<
spcadd:	point 7,0		; byte pointer to file name for FORTRAN call.
chncor:	5,,0			; place to save channel,,core we got from FOROTS
> ; end ifn ftfsub
	list

;DAC PARAMETERS AS SPECIFIED BY USER

	ifon FTMDAC,<
TTYPE:	0
> ; END IFN FTMDAC ABOVE
	list

TNCHNS:	1
TSRATE:	↑D10000
TFILTR:	2

	ifon FTMDAC,<
; POINTERS TO BYTES IN THE CONOWD. INDEXED BY DAC TYPE

FLTPTR:	.ODFB (CONOWD)		; FILTER SETTING BITS
	.NDFB (CONOWD)
CHNPTR:	.ODMB (CONOWD)		; NO. OF CHANELS BITS
	.NDMB (CONOWD)
CLKPTR:	.ODCB (CONOWD)		; CLOCK RATE BITS
	.NDCB (CONOWD)

; POINTERS TO SUBROUTINES TO TURN DAC ON AND OFF

ONADD:	ODACON
OFFADD:	ODACOF
> ; END IFN FTMDAC ABOVE
	list
	SUBTTL	INTERRUPT PROCESSING

	ifon FTKSYS,<
;PLACE TO SAVE LOCATIONS 42 AND 43 IF WE TRPSET
PIWRD1:	0			;CONTENTS OF LOCATION 42
PIWRD2:	0			;CONTENTS OF LOCATION 43

;WORDS TO STICK ON PI LOCATIONS IF WE TRPSET.
BLKOW:	DACIO	(BLKO,diowd)
TRPADR:	JSR	INTRPT
> ; END IFN FTKSYS ABOVE
	list
;START OF INTERRUPT ROUTINE
INTRPT:	0			;INTERRUPT ROUTINE
EXCHWD:	EXCH	I,INDEX		;GET RELOCATION FACTOR AND SAVE I
	EXCH	T,TPOINT(I)	;SAVE T AND GET NEXT IOWD
	DACIO	(CONSZ,MISS)	;CHECK FOR DATA MISSED
	SETOM	MFLG(I)		;YES RAISE MISSED FLAG
	MOVNS	WHATBF(I)	;POINT WHATBF TO NEXT BUFFER
	JUMPGE	T,IDACOF(I)	;IF 0 NO IOWD READY. TURN OFF DAC.
	MOVEM	T,diowd(I)	;RESTORE BLKO POINTER
RETURN:	SETZ	T,		;ZERO IOWD
	EXCH	T,TPOINT(I)	;RESTORE T AND IOWD
	EXCH	I,INDEX(I)	;RESTORE I AND INDEX
JENWD:	JRSTF	@INTRPT		;DISMISS INTERRUPT
IDACOF:	DACIO	(CONO,OFF)	;TURN OFF DAC
	SETOM	DFLG(I)		;RAISE DONE FLAG
	ifon FTKSYS,<
	AOSE	KILFLG(I)	;DID WE TRPSET?
	JRST	RETURN(I)	;RESTORE AND DISMISS
	CONO	PI,1B22!1B29	;IN CASE OF PANIC STOP
	MOVE	T,PIWRD1(I)	;RESET LOCATION 42
	MOVEM	T,42
	MOVE	T,PIWRD2(I)	;RESET LOCATION 43
	MOVEM	T,43
> ; END IFN FTKSYS ABOVE
	list
	JRST	RETURN(I)	;AND RETURN


CONOWD:
	ifon FTMDAC,<
	DACIO	(CONO,DACPI)	;START DAC ON CHANNEL 1
> ; END IFN FTMDAC

	ifoff FTMDAC,<
  IFN FT12B,< 	DACIO	(CONO,ON!DACPI)>
  IFN FT16B,<	DACIO	(CONO,DONE!ON!DACPI)>
> ; END IFE FTMDAC
	list
CCINT:	-1			;KLUDGE FOR LOSING SYSTEM.
INTBLK:	4,INTLOC		;↑C BLOCK
	2
	0
	0

RTBLK:	XWD	1,INTRPT	;PI CH 1,SUBROUTINE ADDRESS
	XWD	1,HEAVEN	;CAN'T GET THERE.
	DACIO	(BLKO,diowd)
	0

RTBOFF:	BLOCK	4

HEAVEN:	0
	HALT

HEADER:	BLOCK	HEDLEN
	subttl high seg constants

	HGHSEG

CRLF:	BYTE	(7)15,12,0

	ifon FTMDAC,<
; POINTERS TO DAC SPECIFIC ROUTINES ( INDEXED BY DAC TYPE 0=12BIT,1=16BIT)

DACDEV:	XWD	3,DAC12		; # OF SAMPLES PER WORD,DEVICE CODE.
	XWD	2,DAC16

CONADD:	OCLK
	NCLK

; POINTERS TO ROUTINES TO START AND STOP THE DAC. INDEXED BY DAC TYPE

DACADD:	ODACON,,ODACOF
	NDACON,,NDACOF
> ; END IFN FTMDAC ABOVE
	list
SUBTTL PROGRAM INITIALISATION - start,

;HERE ON PROGRAM START-UP

	ifoff ftfsub,<
PLAY:	      
	MOVE 0,SBFILN		;OUTPUT NAME FROM 'MUSIC' (6-BIT)
	MOVEM 0,FILE
;;;PLAY:	RESET
> ; end ife ftfsub above
	ifon ftfsub,<
entryp (play,<plyfil>)
	hrrzi	t1,@plyfil(l)	; get address of array containing file name
	hrli	t1,(point 7,0)	; make byte pointer
	movem	t1,spcadd	; save it for inchad.
> ; end ifn ftfsub
	list
	GETPPN	T1,		;GET USER'S PPN
	 JFCL
	MOVEM	T1,MYPPN	;SAVE IT.
	PJOB	T1,		;GET MY JOB #.
	HRLZS	T1		;SET UP FOR GETTAB.
	HRRI	T1,.GTPRV	;GET SOME JOB DATA.
	GETTAB	T1,
	 SETZ	T1,		;LOSING.
;	LDB	T2,[POINT 4,T1,9];LIKE... MAX. HPQ
	ldb	t2,[pointr (t1,jp.hpq)]	; pointer to max run hpq for this job.
	MOVEM	T2,RUNHPQ	;SAVE IT.
;	LDB	T2,[POINT 3,T1,2];AND DISK HPQ.
	ldb	t2,[pointr (t1,jp.dpr)]	; pointer to max disk hpq for this job.
	HRRM	T2,DSKHPQ
	txnn	t1,jp.lck		; can we lock?
	jrst	[outstr [asciz/
?Sorry, you don't have LOCKING privileges. Can't run./]
		exit]
	txnn	t1,jp.rtt		; can we rttrp?
	jrst	[outstr [asciz/
?Sorry, you do not have RTTRP privileges. Can't run./]
		exit]
	ifoff ftfsub,<
;;;	OUTSTR	[ASCIZ \TYPE /H FOR HELP
;;;\]
	ifon FTMT,<
	MOVEI	F,.ATOBS!.ATEOF	;DEFAULT IS AUTO BACKSPACE ON.
> ; END IFN FTMT ABOVE.

; FALL THROUGH TO COMMAND LOOP
	SUBTTL COMMAND LOOP

; FALL THROUGH FROM ABOVE (still in ftfsub conditional)

RETRY2:	JFCL	;**** PDL IN MAIN PROG.    
;;;RETRY2:	MOVE	P,[IOWD 20,PDL]	;SET-UP PDL
	ifon FTKSYS,<
	SETZM	KILFLG		;CLEAR SYSTEM IS DEAD FLAG.
> ; END IFN FTKSYS
	list
	HRRZS	F		;CLEAR TEMP PART OF F.
	ifon FTMT,<
	SETZM	MTPOS		;ZERO MAG-TAPE POSITION COUNTER.
> ; END IFN FTMT
	list
	OUTSTR	[ASCIZ/
PLAY=<RETURN>  EXIT=X /]	;PROMPT USER
	MOVE	P1,DEV		;SET UP DEFAULTS
> ; end ife ftfsub on previous page
	list
ifn ftfsub,< move p1,[sixbit/dskm/] >
	MOVE	P2,FILE
	MOVE	P3,EXT
	SKIPN	P4,MUSPPN
	MOVE	P4,MYPPN	;USE MINE IF NO MUS
	MOVEI	P5,INCHAD	;AND ADDRESS OF ROUTINE TO GET CHARACTER
	PUSHJ	P,PARSE		;GET A FILE SPEC
	 JRST	SYNERR		;CAN'T UNDERSTAND
	CAME	P2,[SIXBIT/X/]
	JRST XPLAY
	OUTSTR [ASCIZ/ PLEASE DELETE SOUND FILES WHEN DONE./]
	POPJ 	P,		;GOES HOME
XPLAY:	MOVEM	P1,DEV		;SET-UP DEVICE FOR OPEN
	MOVEM	P2,FILNAM	;SET UP IN ENTER BLOCK
	MOVEM	P3,FILEXT	;SET UP EXTENSION.
	MOVEM	P4,FILPPN

	ifoff ftfsub,<
	MOVEM	P2,FILE		;YUP. AND REMEMBER IT.
	MOVEM	P3,EXT
	MOVEM	P4,MUSPPN
	JUMPL	T4,SWTCHK	;DON'T RE-INITIALISE DAC PARAMETERS IF NO FILE
	MOVEI	T2,FNCHNS	;SET PARAMETER POINTER TO FILE INFO
	MOVEM	T2,NCHNS
	MOVEI	T2,FSRATE
	MOVEM	T2,SRATE

	ifon FTMDAC,<
	MOVEI	T2,FTYPE
	MOVEM	T2,TYPE
> ; END IFN FTMDAC ABOVE
	list
	MOVEI	T2,FFILTR
	MOVEM	T2,FILTR

; FALL THROUGH TO SWITCH SCANNING
	SUBTTL SWITCH SCANNING

;FALL THROUGH FROM ABOVE (still in ftfsub conditional)

SWTCHK:	CAIE	T1,"/"		;SWITCH DELIMITER?
	JRST	NOSWIT		;NOPE. DON'T RESET CONOWD
	PUSHJ	P,SIXINA	;GET ALPHA-BETIC SIXBIT
	JUMPE	P1,SYNERR	;DON'T ACCEPT BLANK SWITCHES.
	SUBI	P2,6		;NO OF CHARACTERS WE DIDN'T GET.
	IMULI	P2,6		;NO OF PLACES TO SHIFT.
	LSH	P1,(P2)		;SHIFT SWITCH.
	MOVSI	P3,-COMSL	;SET UP AOBJN POINTER
	TLZ	F,.GTSWT	;CLEAR GOT SWITCH BIT.
SCNXT:	MOVE	T2,COMSN(P3)	;GET SWITCH
	LSH	T2,(P2)		;POSITION IT FOR COMPARISON.
	CAMN	T2,P1		;MATCH?
	 JRST	GMATCH		;YUP.
CONSCN:	AOBJN	P3,SCNXT	;NOPE. ANY MORE?
	TLNN	F,.GTSWT	;DID WE GET A MATCH?
	 JRST	SYNERR		;NOPE. COMPLAIN.
GOTIT:	POPJ	P,		;PROCESS IT.

GMATCH:	TLOE	F,.GTSWT	;HAVE WE ALREADY FOUND THIS SWITCH?
	 JRST	AMBIG		;COMPLAIN.
	MOVE	T2,COMSD(P3)	;GET ITS DISPATCH ENTRY,
	PUSH	P,T2		;SAVE IT
	TLNE	T2,SW.OK1	;NEED WE GO FURTHER?
	 JRST	GOTIT		;NOPE.
	JRST	CONSCN		;AND CONTINUE SCAN.

AMBIG:	POP	P,P3		;FIX THE STACK
	OUTSTR	[ASCIZ /
?AMBIGUOUS SWITCH
/]
	TLO	F,.UBLEW	;SET USER BLEW IT FLAG
	JRST	SWTCHK		;AND CONTINUE SCAN.

NOSWIT:	CAIE	T1,12		;GOT LINE-FEED?
	CAIN	T1,33		;OR ESCAPE?
	JRST	GOTEOL
	CAIE	T1," "		;WELL THEN, WAS IT A SPACE ?
	CAIN	T1,","		;OR COMMA?
	JRST	EATCHR		;YUP. EAT IT UP.
	CAIE	T1,15		;IT BETTER BE A <CR>
	JRST	SYNERR		;NOPE. COMPLAIN.

EATCHR:	PUSHJ	P,(P5)		;NOPE. EAT ANOTHER CHARACTER
	JRST	SWTCHK		;TRY AGAIN

; still in ftfsub conditional
	SUBTTL SWITCHES

; still in ftfsub conditional

;DISPATCH TABLE BITS
	SW.OK1=100	;ACCEPT SINGLE LETTER FOR THIS SWITCH

	DEFINE	SCAN(PFX),<
		DEFINE X($NAME,$BITS,$DSPAT),<
	EXP	SIXBIT	/$NAME/
>
PFX'N:	SWTCHS
PFX'L==.-PFX'N
		DEFINE X($NAME,$BITS,$DSPAT),<
	XWD	$BITS,$DSPAT
>
PFX'D:	SWTCHS
>

	DEFINE SWTCHS,<
	X (MODE,SW.OK1,SMODE)
	X (CLOCK,SW.OK1,SCLOCK)
	X (FILTER,SW.OK1,SFILT)
	ifon FTKSYS,<
	X (KSYS,SW.OK1,SKILL)
> ; END IFN FTKSYS ABOVE
	ifon FTMT,<
	X (REWIND,SW.OK1,SREWMT)
	X (ADVANC,,SFORMT)
	X (BACKSP,SW.OK1,SBAKMT)
	X (NOAUTO,SW.OK1,SNAUTO)
	X (AUTOBS,,SAUTO)
> ; END IFN FTMT ABOVE
	list
;	x (aid,sw.ok1,getaid)
;;	X (HELP,SW.OK1,GETHLP)
	X (WHAT,SW.OK1,STELL)
	ifon FTMDAC,<
	X (TYPE,SW.OK1,STYPE)
> ; END IFN FTMDAC ABOVE
	list
>

	SCAN	COMS

; still in ftfsub conditional
	SUBTTL SWITCH PROCESSING

; still in ftfsub conditional

	ifon FTMDAC,<
; HERE TO SET WHICH DAC - /TYPE: SWITCH

STYPE:	PUSHJ	P,DECIDL	; GET DAC SPECIFICATION
	CAIN	P1,↑D12		; 12 - BIT DAC ?
	JRST	SODAC		; YUP. GO SET UP FOR OLD ONE
	CAIN	P1,↑D16		; 16 - BIT DAC ?
	JRST	SNDAC
	OUTSTR	[ASCIZ/
? ONLY 12 OR 16 BIT DACS SUPPORTED
/]
	TLO	F,.UBLEW	; SET "USER BLEW IT" FLAG.
	JRST	SWTCHK		; AND CHECK FOR MORE SWITCHES

SODAC:	SKIPA	T2,[EXP 0]	; GET OLD DAC DEVICE CODE
SNDAC:	MOVEI	T2,1		; GET NEW DAC DEVICE CODE
	MOVEM	T2,TTYPE	; SAVE DEVICE CODE
	MOVEI	T2,TTYPE
	MOVEM	T2,TYPE
	JRST	SWTCHK		; LOOP FOR MORE SWITCHES
> ; END IFN FTMDAC ABOVE
	list
;HERE TO SET MODE - /M SWITCH

SMODE:	PUSHJ	P,DECIDL	;GET NUMBER OF CHANNELS
	JUMPE	P1,SWTCHK	;MODE 0 IS A LOSER.
	CAIG	P1,4		;ONLY 4 CHANNELS
	JRST	GOTMOD		;OK
	OUTSTR	[ASCIZ /
MAXIMUM OF 4 CHANNELS
/]
	TLO	F,.UBLEW	;SET "USER BLEW IT" FLAG.
	JRST	.+2
GOTMOD:	CAIN	P1,3		;3 REALLY MEANS 4.
	MOVEI	P1,4
	MOVEM	P1,TNCHNS	;SAVE NUMBER OF CHANNELS
	MOVEI	P1,TNCHNS
	MOVEM	P1,NCHNS	;RESET PARAMETER POINTER
	JRST	SWTCHK		;AND CHECK FOR MORE SWITCHES

; still in ftfsub condtional
;HERE TO SET CLOCK - /C SWITCH

; still in ftfsub conditional

SCLOCK:	PUSHJ	P,DECIDL	;GET A NUMBER.
	JUMPE	P1,SWTCHK	;0 IS A LOSING CLOCK RATE.
	PUSH	P,T1		;SAVE DELIMITER.
	CAIGE	P1,↑D4000	;DOES HE MEAN KC ?
	IMULI	P1,↑D1000	;ASSUME SO.
	SKIPE	T2,P2		;GET EXPONENT
	IDIVI	P1,↑D10		;DO THE DIVIDE.
	SOJG	T2,.-1		;LOOP.
	MOVEM	P1,TSRATE	; SAVE SAMPLING RATE.
	MOVEI	T1,TSRATE
	MOVEM	T1,SRATE
	POP	P,T1		;RESTORE DELIMITER
	JRST	SWTCHK		;CHECK FOR MORE SWITCHES

;HERE TO SET FILTERS

SFILT:	PUSHJ	P,DECIDL	;GET FILTER SETTING
	JUMPN	P2,BADFLT	;FRACTIONAL FILTERS ARE OUT.
	CAIG	P1,2
	JRST	GOTFLT
BADFLT:	OUTSTR	[ASCIZ /
POSSIBLE FILTER SETTINGS ARE 0,1, OR 2.
/]
	MOVEI	P1,2
	TLO	F,.UBLEW	;SET USER BLEW IT FLAG.

GOTFLT:	MOVEM	P1,TFILTR	;SAVE FILTER SETTINGS
	movei	t2,tfiltr
	movem	t2,filtr	; point filter to the right place
	JRST	SWTCHK

; still in ftfsub conditional
;HERE TO SET "KILL SYSTEM" FLAG -/K SWITCH
; still in ftfsub conditional
	ifon FTKSYS,<

SKILL:	TLO	F,.KSYS		;REMEMBER...
	JRST	SWTCHK
> ; END IFN FTKSYS ABOVE
	list
; HERE ON "WHAT" SWITCH	- /W SWITCH

STELL:	PUSH	P,T1		;SAVE DELIMITER
	TLO	F,.ONLYH	;DON'T PLAY.
	ifon FTMDAC,<
	OUTSTR	[ASCIZ /CURRENT DAC = /]
	HRRZ	T1,@TYPE	; GET TYPE
	OUTSTR	@[EXP	[ASCIZ /12 - BIT/]
		 EXP	[ASCIZ /16 - BIT/]](T1)
> ; END IFN FTMDAC ABOVE
	list
	OUTSTR	[ASCIZ /
CURRENT SAMPLING RATE = /]
 	HRRZ	T1,@SRATE
	PUSHJ	P,DECOUT
	OUTSTR	[ASCIZ /
CURRENT FILTER SETTINGS = /]
	MOVE	T1,@FILTR
	PUSHJ	P,DECOUT
	OUTSTR	[ASCIZ /
CURRENT # OF CHANNELS = /]
	MOVE	T1,@NCHNS
	PUSHJ	P,DECOUT
	OUTSTR	[ASCIZ /
/]
	POP	P,T1
	JRST	SWTCHK

;HERE TO TYPE OUT HELP MESSAGE - /H SWITCH

;;GETHLP:	PUSH	P,T1		;SAVE DELIMITER
;;	TLO	F,.ONLYH	;FORGET ABOUT PLAYING
;;	MOVE	T1,[SIXBIT /PLAY/]
;;	PUSHJ	P,.HELPR	;CALL HELP
;;	TLO	F,.UBLEW	;PICK UP MORE SWITCHES,
;;	POP	P,T1		;RESTORE DELIMITER
;;	JRST	SWTCHK		;BUT DON'T PLAY.

; still in ftfsub conditional
	SUBTTL MAG TAPE SWITCHES
; still in ftfsub conditional

	ifon FTMT,<

;HERE TO REWIND MAG TAPE	- /W SWITCH

SREWMT:	TLO	F,.REWMT	;SET REWIND FLAG.
	JRST	SWTCHK

;HERE TO ADVANCE FILES ON MAG-TAPE -/A SWITCH

SFORMT:	PUSHJ	P,DECIDL	;GET ADVANCE COUNT
	SKIPN	P1
	AOJ	P1,		;0=1
	JUMPN	P2,BADMT	;FRACTIONAL ADVANCES ARE DUBIOUS.
UPDPOS:	ADDM	P1,MTPOS	;UPDATE POSITION COUNTER
	JRST	SWTCHK		;AND CHECK FOR MORE SWITCHES.

;HERE TO BACKUP FILES ON MAG-TAPE - /B SWITCH

SBAKMT:	PUSHJ	P,DECIDL	;GET BACKUP COUNT
	SKIPN	P1
	AOJ	P1,
	JUMPN	P2,BADMT
	MOVNS	P1
	JRST	UPDPOS		;UPDATE POSITION COUNTER.

BADMT:	TLO	F,.UBLEW	;SET THE USER BLEW IT FLAG
	OUTSTR	[ASCIZ /
?FRACTIONAL MAG-TAPE POSITIONING IS DUBIOUS.
/]
	JRST	SWTCHK		;AND CHECK FOR MORE SWITCHES.

;HERE TO SET AUTO BACKSPACE MODE.

SAUTO:	TRO	F,.ATOBS
	JRST	SWTCHK

;HERE TO CLEAR AUTO BACKSPACE MODE.

SNAUTO:	TRZ	F,.ATOBS
	JRST	SWTCHK
>	; END FTMT CONDITIONAL ABOVE
	list
; still ftfsub condtional
	subttl lookup file and read in header

; still in ftfsub conditional

GOTEOL:	TLNE	F,.UBLEW	;FORGET ABOUT PLAYING IF USER
	JRST	RETRY2		;BLEW IT.
> ; end ife ftfsub conditional from many pages ago
	ifon ftfsub,<
	movei	t3,dsk		; get the number of the i/o channel we want
	pushj	p,chnget	; get the i/o channel
	 jrst	[outstr [asciz\
?couldn't get i/o channel 5 from FOROTS.
Tell Jim to make this program smarter.\]
		exit]
> ; end ifn ftfsub above
	list
	OPEN	DSK,OSPEC
	 JRST	INITER
	ifon FTMT,<
	MOVEI	T1,DSK		;NOW WHAT KIND OF DEVICE IS THAT?
	DEVCHR	T1,
	TLO	F,.MTDEV	;PRETEND IT'S MAG-TAPE
	TLNN	T1,(DV.DIR)	;DOES IT HAVE A DIRECTORY?
	JRST	NOLKUP		;NOPE. DON'T BOTHER WITH LOOKUP.
LKUP:	TLZ	F,.MTDEV	;CLEAR MAG-TAPE BIT.
> ; END IFN FTMT ABOVE
	list
	LOOKUP	DSK,EXLKUP	;DO EXTENDED LOOK-UP TO GET FILE LENGTH
	 JRST	LKUPER
	showit	dsk,		; show progress
	 jfcl
NOLKUP:	TLZ	F,.FHEAD	;CLEAR HEADER BIT.
	IN	DSK,HIOWD	;READ IN THE HEADER
	 JRST	.+2
	 JRST	HEDERR		;WHAT CAN THIS MEAN?
	MOVE	T1,IDLOC+HEADER	;GET UNLIKELY WORD
	CAME	T1,[525252525252]
	 JRST	NOHEAD		;DOESN'T HAVE ONE.
	HRRZ	T1,PLOC+HEADER	; CHECK PACKING MODE.

	ifoff FTMDAC,<
	CAIN	T1,.GDTYP	; ALLOWABLE MODE ?
> ; END IFE FTMDAC ABOVE

	ifon FTMDAC,<
	JUMPE	T1,GPAK		; ITS 12-BIT. GO AHEAD.
	CAIN	T1,1		; 16 - BIT. THAT'S OK TOO.
> ; END IFN FTMDAC ABOVE
	list
	JRST	GPAK
	OUTSTR	[ASCIZ/
?FILE IS NOT IN PROPER MODE FOR PLAYING.
/]
	JRST	RETRY2

GPAK:

	ifon FTMDAC,<
	MOVEM	T1,FTYPE	; SAVE FILE TYPE
> ; END IFN FTMDAC ABOVE
	list
	MOVE	T1,CHNLOC+HEADER;SET UP DEFAULTS
	MOVEM	T1,FNCHNS	;SAVE NUMBER OF CHANNELS
	HRRZ	P1,CLOC+HEADER
	MOVEM	P1,FSRATE

	TLO	F,.FHEAD	;REMEMBER FILE HAS A HEADER

	ifon ftfsub,<
	jrst	nopos		; go and play
nohead:	outstr	[asciz/
?File doesn't have a header!
/]
retry2:	popj	p,
> ; end ifn ftfsub above

	ifoff ftfsub,<
;CHECK FOR /WHAT SWITCH

NOHEAD:	TLNN	F,.ONLYH	; JUST WANT TO READ HEADER ?
	JRST	NOWHAT		; NOPE. GO ON AND PLAY

; FALL THROUGH TO HEADER TYPE OUT

; still in ftfsub conditional
	SUBTTL HEADER TYPE OUT

; still in ftfsub conditionl

;HERE AFTER WE'VE LOOKED UP THE FILE AND READ IN THE HEADER BLOCK

TELL:	OUTSTR	[ASCIZ /FILE NAME - /]
	MOVE	T1,DEV
	MOVE	T2,FILE
	MOVE	T3,EXT
	MOVE	T4,MUSPPN
	PUSHJ	P,TYSPEC	;TYPE THE FILE SPEC.
	TLNN	F,.FHEAD	;DOES FILE HAVE A HEADER?
	 JRST	 NOHEDR		;NOPE. FORGET ABOUT IT.

	ifon FTMDAC,<
	OUTSTR	[ASCIZ/
FILE TYPE IS /]
	HRRZ	T1,FTYPE	; GET TYPE ACCORDING TO FILE
	OUTSTR	@[EXP	[ASCIZ/12 - BIT/]
		 EXP	[ASCIZ/16 - BIT/]](T1)
> ; END IFN FTMDAC ABOVE
	list
	OUTSTR	[ASCIZ /
SAMPLING RATE = /]
	HRRZ	T1,FSRATE	;GET SAMPLING RATE
	PUSHJ	P,DECOUT	;TYPE RATE
	OUTSTR	[ASCIZ /
NUMBER OF CHANNELS = /]
	MOVE	T1,FNCHNS	;GET NUMBER OF CHANNELS
	PUSHJ	P,DECOUT
	OUTSTR	[ASCIZ /
/]
	SKIPE	TLOC+HEADER	;ANY TEXT?
	OUTSTR	TLOC+HEADER
	JRST	.+2
NOHEDR:	OUTSTR	[ASCIZ /
[FILE DOESN'T HAVE A HEADER]/]
	OUTSTR	[ASCIZ /
/]
;	MOVNI	T1,1
;	TLNE	F,.MTDEV	;IS IT MAG-TAPE?
;	PUSHJ	P,BAKWRD	;YUP. BACKSPACE OVER HEADER BLOCK
	JRST	RETRY2

; still in ftfsub conditional
	SUBTTL MAG TAPE PRE-POSITIONING

; still in ftfsub conditional

NOWHAT:
	ifon FTMT,<
;START POSITIONING IF MAG-TAPE.

	TLNN	F,.MTDEV	;IS INPUT DEVICE MAG-TAPE?
	JRST	NOPOS		;NOPE. FORGET POSITIONING

;HERE TO POSITION MAG-TAPE BEFORE PLAYING.

	TLNE	F,.REWMT	;DO A REWIND?
	MTREW.	DSK,		;YUP.
	SKIPN	T1,MTPOS	;POSITION THE TAPE?
	 JRST	DONPOS		;NOPE. CONTINUE.
	JUMPG	T1,FORWRD	;YUP. SPACE FORWARD.
	PUSHJ	P,BAKWRD	;DO THE BACKSPACE.
	JRST	DONPOS

FORWRD:	MTSKF.	DSK,		;SPACE FORWARD
	MTWAT.	DSK,		;WAIT FOR IT.
	STATZ	DSK,IO.EOT	;HIT END OF TAPE?
	 JRST	EOTER		;YUP. TELL USER.
	SOJG	T1,FORWRD	;LOOP
DONPOS:	MTWAT.	DSK,		;WAIT FOR POSITIONING TO FINISH.
	SETZM	MTPOS		;CLEAR POSITION COUNTER.

>	; END FTMT CONDITIONAL ABOVE
	list
; FALL THROUGH TO DAC CONTROL WORD SETUP.
	SUBTTL SET UP DAC CONTROL WORD

> ; end ife ftfsub conditional from many pages ago
	list
; FALL THROUGH FROM ABOVE

NOPOS:
	ifon FTMDAC,<
	MOVE	P1,@TYPE	; GET POINTER TO APPROPRIATE DAC SPECS.
	MOVE	T1,DACADD(P1)	; GET ON,,OFF ADDRESSES
	HLRZM	T1,ONADD	; SET ON ADDRESS
	HRRZM	T1,OFFADD	; SET OFFADD
	HRRZ	T1,DACDEV(P1)	; GET DAC DEVICE CODE.
	ASH	T1,-2
	MOVSI	T3,-..IOL	; SET UP AOBJN WORD FOR POINTER LIST
DEVLOP:	MOVE	T2,..IOP(T3)	; GET POINTER WORD
	DPB	T1,T2		; STICK DAC DEVICE CODE IN WORD
	AOBJN	T3,DEVLOP	; LOOP

	HLRZ	T1,DACDEV(P1)	; GET SAMPLES PER WORD
	MOVEM	T1,NSAMPW	; SAVE IT FOR TIMING CALCULATIONS
> ; END IFN FTMDAC ABOVE
	list
	MOVE	T1,@FILTR	;GET FILTER SETTINGS
	DOFLT	(CONOWD)
	MOVE	T1,@NCHNS	;GET NUMBER OF CHANNELS
	cain	t1,4		; 4 channels ?
	movei	t1,3		; means 3.
	DOCHN	(CONOWD)
	CONCLK
	 JRST	[MOVEM	T1,TSRATE 
		OUTSTR	[ASCIZ/[USING CLOCK RATE OF /]
 		PUSHJ	P,DECOUT
		OUTSTR	[ASCIZ/]
/]
		MOVEI	T1,TSRATE
		MOVEM	T1,SRATE
		JRST	.+1]
	DOCLK	(CONOWD)

; FALL THROUGH TO SET VARIOUS IOWD'S.
	SUBTTL SET UP VARIOUS IOWD'S.

; FALL THROUGH FROM ABOVE

SIOWD:	SETZM	LIOWD		;CLEAR LAST IOWD.
	MOVN	T1,FILSIZ	;GET NEGATIVE LENGTH OF FILE IN WORDS
	ADDI	T1,HEDLEN	;PLUS WHAT WE'VE READ SO FAR.
	JUMPGE	T1,NULFIL	;DON'T BOTHER PLAYING NULL FILES.
	IDIVI	T1,SIZE		;WHAT WE REALLY WANT IS THE REMAINDER
	SKIPN	T2		; EXACTLY ONE BUFFER?
	MOVNI	T2,SIZE		; YES. LAST IOWD IS A FULL BUFFER
	HRLZM	T2,LIOWD	;SAVE AS LAST IOWD
	MOVEI	T1,SIZE		;GET BUFFER SIZE
	IMULI	T1,↑D15		; * TRANSFER RATE PER WORD (IN MICRO SECS.)
	IMUL	T1,@NCHNS	; * NUMBER OF CHANNELS
	HRRZ	T3,@SRATE	; GET SAMPLING RATE
	MUL	T1,T3		; * SAMPLING RATE
	DIV	T1,[↑D1000000]	; / 10↑-6
	ifon FTMDAC,<
	IDIV	T1,NSAMPW	; / NO. OF SAMPLES PER WORD.
> ; END IFN FTMDAC ABOVE

	ifoff FTMDAC,<
	ifon FT12B,<
	IDIVI	T1,3		; / NO OF SAMPLES PER WORD
> ; END IFN FT12B ABOVE
	ifon FT16B,<
	IDIVI	T1,2		; / NO OF SAMPLES PER WORD
> ; END IFN FT16B ABOVE
> ; END IFE FTMDAC ABOVE
	list
	MOVNS	T1		;NEGATE IT.
	HRLZM	T1,TIOWD	;SET COUNT FOR TIMING IOWD
	ADDI	T1,SIZE
	HRRM	T1,TIOWD	;SET ADDRESS FOR TIMING IOWD.
	xlist
IFN	0,< ;THIS DOESN'T WORK ON LOSING SYSTEMS.
IFN FTMDAC,<
	IMUL	T1,NSAMPW	;NOW COMPUTE TIME .
> ; END IFN FTMDAC ABOVE
IFE FTMDAC,<
	IFN FT12B,<
	IMUL	T1,3		; COMPUTE TIME
> ; END IFN FT12B ABOVE
	IFN FT16B,<
	IMUL	T1,2
> ; END IFN FT16B ABOVE
> ; END IFE FTMDAC ABOVE

	MULI	T1,↑D1000	;IN MILLISECONDS.
	HRRZ	T3,@SRATE	; GET SAMPLING RATE
	DIV	T1,T3
	IDIV	T1,@NCHNS
	SUBI	T1,UUOLOS	;FUDGE FOR LOSING SYSTEM.
	MOVEM	T1,SLPTIM
>	;END IFN 0,
	list
	ifoff ftfsub,<
	HRRZ	T1,.JBFF	;HOW BIG ARE WE?
	MOVEM	T1,OLDSIZ	; SAVE OUR PREVIOUS SIZE
	SOJ	T1,		;FUDGE IT FOR THE IOWD
	HRRM	T1,BP1		;SAVE AS IOWD ADDRESS
	ADDI	T1,SIZE		;SIZE OF A BUFFER
	HRRM	T1,BP2		;BUFFER 2 IOWD.
	ADDI	T1,SIZE+1	;REQUEST 2 BUFFERS WORTH.
	CORE	T1,		;NOPE. GET SOME MORE CORE.
	 JRST	CORER		;YOU LOSE.
> ;end ife ftfsub above
	ifon ftfsub,<
	movei	t3,2*size	; get 2 buffers worth of core
	PUSHJ	P,CORGET	;GET THAT MUCH CORE.
	 JRST	corer		;NO MORE ROOM...
	hrrm	t2,chncor	; save it for release.
	subi	t2,1		; iowd address begins one down
	hrrm	t2,bp1		; save iowd address
	addi	t2,size		; address for second buffer
	hrrm	t2,bp2		; save its iowd address
> ; end ifn ftfsub above
	list
	MOVE	T2,BP1		;SET UP INITIAL IOWD
	MOVEM	T2,IBP1

	ifoff ftfsub,<
	TLNE	F,.FHEAD	;IF FILE HAS HEADER,
	JRST	RETRY1		;GO ON TO LOCKING STUFF.
	ADD	T2,[HEDLEN,,HEDLEN]
	MOVEM	T2,IBP1		;FUDGE INITIAL IOWD
	MOVSI	T1,HEADER
	HRR	T1,BP1		;SET UP BLT POINTER
	ADDI	T1,1		;FUDGE FOR IOWDS
	ADDI	T2,1
	BLT	T1,(T2)		;MOVE NON-HEADER INTO BUFFER.
> ;end ife ftfsub above
	list
; FALL THROUGH TO LOCKING AND PI SETUP.
	SUBTTL LOCKING AND PI SETUP

; FALL THROUGH FROM ABOVE

RETRY1:	MOVE	SETUP,[EXP LK.HNP!LK.HLS!LK.LNP!LK.LLS]	;LOCK IN CORE
	LOCK	SETUP,
	 JRST	LOCKER		;LOSING...
LOCKED:	HRRZ	SETUP,SETUP	;GET RELOCATION FROM LOCK UUO
	LSH	SETUP,9		;AND CONVERT PAGE TO WORD ADDRESS
	MOVEM	SETUP,INDEX	;STORE IN INDEX
	MOVEI	T1,INDEX	;RELOCATE SOME INSTRUCTIONS
	ADDI	T1,(SETUP)
	HRRM	T1,EXCHWD
	MOVEI	T1,INTRPT
	ADDI	T1,(SETUP)
	HRRM	T1,JENWD
	MOVE	T1,BP1		;GET BF1 IOWD.
	MOVEM	T1,diowd	;CREATE IOWD FOR BLKO (RTTRP WILL
				;RELOCATE THE ADDRESS IN diowd)
	ADDI	T1,(SETUP)	;RELOCATE IT
	MOVEM	T1,RBP1
	MOVE	T1,BP2		;GET IOWD FOR BUFFER 2.
	ADDI	T1,(SETUP)
	MOVEM	T1,RBP2		;SAVE IT.
	ifon ftfsub,<
	pushj	p,pshint	; save interrupt system status
> ; end ifn ftfsub above
	list
	SETOM	CCINT		;SET KLUDGE FLAG
	MOVEI	SETUP,INTBLK	;GRAB ↑C
	MOVEM	SETUP,.JBINT
	ifon FTKSYS,<
	SETZM	KILFLG		;JUST TO BE SURE
	TLNE	F,.KSYS		;USER WANTS TIME-SHARING STOPPED?
	JRST	KSYS		;YUP. DO IT.
> ; END IFN FTKSYS ABOVE
	list
	MOVEI	SETUP,RTBLK	;CONNECT DAC.
	RTTRP	SETUP,
	 JRST	TRPERR		;AFTER ALL THAT TROUBLE...
	MOVSI	SETUP,(JRSTF @0);SET UP RTTRP EXIT
	ifon FTKSYS,<
	JRST	PISET

KSYS:	MOVE	SETUP,[XWD 42,BLKOW]
	TRPSET	SETUP,		;SET UP PI-CHANNEL 1.
	 JRST	TRPERR
	MOVEM	SETUP,PIWRD1	;SAVE OLD CONTENTS FOR RESTORE.
	MOVE	SETUP,[XWD 43,TRPADR]
	TRPSET	SETUP,		;
	 JRST	TRPERR
	MOVEM	SETUP,PIWRD2
	SETOM	KILFLG
	MOVSI	SETUP,(JEN @0)	;SET UP TRPSET EXIT
> ; END IFN FTKSYS ABOVE
	list
; FALL THROUGH TO BUFFER INITIALISATION
	SUBTTL BUFFER INITIALISATION

; FALL THROUGH FROM ABOVE

PISET:	HLLM	SETUP,JENWD	;SET UP KIND OF INTERRUPT EXIT
	SETZM	MFLG		;LOWER MISSED FLAG
	SETZM	DFLG		;LOWER DONE FLAG
	MOVE	T1,RBP2		;GET RELOCATED IOWD FOR BUFFER 2.
	MOVEM	T1,TPOINT	;SET UP NEXT IOWD FOR DAC.
	SETOM	WHATBF		;POINT WHATBF TO BUFFER 1
	SKIPE	T1,RUNHPQ	;GET OUR MAXIMUM HPQ.
	HPQ	T1,
	 JFCL			;IGNORE.
	ifon FTMT,<
	TLNE	F,.MTDEV	;DO WE HAVE A DISK?
	 JRST	DONEQ
> ; END IFN FTMT ABOVE
	list
	MOVE	T1,[XWD .DUPRI,DSKHPQ]
	SKIPE	DSKHPQ		;NON-ZERO MAX PRIORITY?
	DISK.	T1,
	 JFCL
DONEQ:	IN	DSK,IBP1	;FILL FIRST BUFFER FROM DSK
	SKIPA
	 JRST	[PUSHJ	P,ERREOF; check for eof or error
		JRST	SETLST	; eof. SET UP LAST IOWD.
		JRST	BUF2]	; error. ignore and continue.
BUF2:	IN	DSK,BP2		;FILL BUFFER 2.
	JRST	STRDAC
	 JRST	[PUSHJ	P,ERREOF; check for error or eof.
		 JRST	EOF2	; eof. set up last iowd.
		 JRST	STRDAC]	; error. ignore and continue
EOF2:	MOVSI	T1,-SIZE	;GET SIZE OF A FULL BUFFER
	ADDM	T1,LIOWD	;UPDATE LAST IOWD.
SETLST:	PUSHJ	P,GLSTLN	;GET LENGTH OF LAST TRANSFER.
	JUMPGE	T1,NULFIL	;COMPLAIN ABOUT NULL FILES
	HLLM	T1,diowd
	SETZM	LIOWD
	SETZM	TPOINT		;ZERO NEXT IOWD FOR DAC
STRDAC:	DACON			; TURN ON THE DAC
	OUTSTR	[ASCIZ/
playing
/]
	ifon FTMT,<
	TRZ	F,.ATEOF	;CLEAR "AT EOF" FLAG.
> ; END IFN FTMT
	list
	STATZ	DSK,IO.EOF	;END OF FILE ALREADY?
	 JRST	EOFI		;YUP. FORGET ABOUT MAIN LOOP.
	SUBTTL	MAIN PLAY LOOP

LOOP:
	xlist
IFN	0,<		;DOESN'T WORK ON LOSING SYSTEMS.
	SKIPLE	T1,SLPTIM	;WAKE WHEN ITS TIME TO START REFILL.
	HIBER	T1,
	 JFCL			;HAVE TO STAY AWAKE.
>	;END IFN 0,
	list
	MOVE	P2,WHATBF	;GET BUFFER POINTER FLIP-FLOP
	HRRZ	P1,RBP1+1(P2)	;GET RELOCATED BUFFER ADDRESS
	ADD	P1,TIOWD	;GET TIMING IOWD.
TIMCHK:	PUSHJ	P,ERCHK		;EVERYTHING STILL OK ?
	SKIPE	TPOINT		;UNLIKELY...BUT...
	CAME	P2,WHATBF	;YAWN...SHOULD WE PANIC ?
	JRST	DOREAD		;YIPES! DAC SNUCK BY!
	CAML	P1,diowd	;HAS DAC REACHED REFILL POINT YET?
	JRST	TIMCHK		;NOPE. GUESS WE WOKE TO SOON.

;HERE WHEN WE CAN DO THE NEXT READ.
;NOTE. WE MAY HAVE MISSED THE DAC AND IT MAY BE WORKING
;IN THE NEXT BUFFER BUT THATS ALL RIGHT BECAUSE WE ARE USING
;THE OLD "WHATBF" FLAG.

DOREAD:	MOVE	P1,RBP1+1(P2)	;GET NEXT BUFFER ADDRESS.(RELOCATED)
	HRRM	P1,LIOWD	;REMEMBER THE ADDRESS IN CASE OF EOF.
	IN	DSK,BP1+1(P2)	;READ THE BUFFER.
DACWT:	SKIPA	T2,TPOINT	;HAS DAC STARTED ON NEXT BUFFER?
	JRST	[PUSHJ	P,ERREOF; check for error or eof.
		 JRST	EOF	; eof. wait for dac
		 JRST	RDERR]	; error. ignore and continue.
RDERR:	PUSHJ	P,ERCHK		; SEE IF THE DAC HAS STOPPED
	JUMPN	T2,DACWT	; IN CASE WE HAD A DISK ERROR AND
				; RETURNED EARLY.
	MOVEM	P1,TPOINT	;SET UP NEXT IOWD FOR DAC.
	JRST	LOOP		;AND CONTINUE.

; here on input error or eof.
; returns call + 1 on eof, call + 2 on error.

ERREOF:	STATZ	DSK,IO.EOF	; check eof bit.
	POPJ	P,		; eof. return to call + 1.
	PUSH	P,T1		; save t1.
	OUTSTR	[ASCIZ/
? Input error. Device status = /]
	GETSTS	DSK,T1		; get device status
	PUSHJ	P,OCTSP		; type it out in octal
	OUTSTR	[ASCIZ/. Continuing.../]
	XCT	SSTINS		; EXECUTE THE SETSTS INSTRUCTION
	POP	P,T1
	AOS	(P)		; take skip return
	POPJ	P,
	subttl end of file. cleanup

;HERE TO TERMINATE A RUN,WAIT FOR THE DAC TO FINISH
EOF:	PUSHJ	P,GLSTLN	;GET LENGTH OF LAST TRANSFER.
	JUMPGE	T1,EOFI		;NOTHING.
	SKIPE	TPOINT		;WAIT FOR DAC PLEASE.
	 JRST	.-1
	MOVEM	T1,TPOINT	;SET UP IOWD FOR LAST READ
EOFI:
	ifon FTMT,<
	TRO	F,.ATEOF	;SET "AT EOF" FLAG.
> ; END IFN FTMT ABOVE
	list
X1:	SKIPL	DFLG		;WAIT FOR DAC TO FINISH.
	JRST	.-1
	ifon FTKSYS,<
	TLNE	F,.KSYS		;SHOULD WE RESTORE THE SYSTEM.
	JRST	RSTSYS		;YUP. DO IT.
> ; END IFN FTKSYS ABOVE
	list
	MOVEI	SETUP,RTBOFF
	RTTRP	SETUP,
	 JFCL
	JRST	SYSSET

	ifon FTKSYS,<
RSTSYS:	SETZ	SETUP,
	TRPSET	SETUP,		;TURN TIME-SHARING BACK ON.
	JFCL
	SETZM	KILFLG		;TURN OFF "DEAD" FLAG.
> ; END IFN FTKSYS ABOVE
	list
SYSSET:	SETZM	.JBINT		;DISABLE ↑C TRAPPING
	move	setup,[xwd 1,1]	;UNLOCK
	UNLOK.	SETUP,
	 JFCL			;IGNORE ANY ERRORS
	SETZ	T1,
	HPQ	T1,
	 JFCL
	CLOSE	DSK,
	ifoff ftfsub,<
	HRRZ	SETUP,OLDSIZ	; GET OUR OLD SIZE
	CORE	SETUP,		;REDUCE.
	 JFCL
> ; end ife ftfsub above
	ifon ftfsub,<
	hrrz	t2,chncor	; get location of extra core
	pushj	p,correl	; release the core
givchn:	hlrz	t2,chncor	; get the i/o channel
	pushj	p,chnrel	; release the channel
	pushj	p,popint	; restore interrupt system status
> ; end ifn ftfsub
	ifon FTMT,<
	TLNE	F,.MTDEV	;IS IT MAG-TAPE?
	TRNN	F,.ATOBS	;DO YOU WANT AUTO BACKSPACE?
	JRST	RETRY2		;NOPE.
	MOVNI	T1,1
	PUSHJ	P,BAKWRD	;COLLECT THOSE FREE BACKSPACES.
> ; END IFN FTMT ABOVE
	list
	JRST	RETRY2		;GO BACK FOR MORE


;HERE TO CHECK THE DAC FOR VARIOUS ERRORS

ERCHK:	SKIPE	MFLG		;THIS CAN ONLY HAPPEN IF SOMEONE HAS
	JRST	MISSED		;TURNED OFF THE PI SYSTEM FOR TOO LONG
	SKIPE	DFLG		;IF DONE FLAG IS RAISED HERE - ERROR
	JRST	SLOW		;NEXT IOWD WAS NOT READY
	DACIO	(CONSO,BUSY)	;IS DAC ALIVE?
	 JRST	DEADAC		;NOPE. DON'T BOTHER WAITING
	POPJ	P,
	subttl user errors

; here on syntax error trying to parse command string

SYNERR:	JFCL

erioin:
	ifon ftfsub,<
; here on any initialisation i/o error if we have been called from FORTRAN.
; give the i/o channel back to FOROTS.

	hlrz	t2,chncor	; get FOROTS allocated i/o channel.
	pushj	p,chnrel	; release the channel.
> ; end ifn ftfsub above
	list
ERRET:	OUTSTR	CRLF
	jrst	retry2		; go back to command loop or return if sub

; here when we can't open input device

INITER:	OUTSTR	[ASCIZ /?Can't open input device /]
	MOVE	T1,DEV		;GET DEVICE NAME.
	PUSHJ	P,TYDEV		;TYPE IT OUT.
	jrst	erioin		;TAKE COMMON ERROR RETURN

; here when we can't lookup input file.

LKUPER:	OUTSTR	[ASCIZ /?Can't find /]
	MOVE	T1,DEV
	MOVE	T2,FILE
	MOVE	T3,EXT
	MOVE	T4,MUSPPN
	PUSHJ	P,TYSPEC	;TYPE FILE SPEC
	OUTSTR	[ASCIZ /
LOOKUP error code = /]
	HRRZ	T1,FILEXT	;GET ERROR CODE
	PUSHJ	P,OCTOUT	;AND TYPE IT
	jrst	erioin

; here in i/o error trying to read in header.

HEDERR:	OUTSTR	[ASCIZ\
?I/O error trying to read header block\]
	jrst	erioin

; here on zero length file.

NULFIL:	OUTSTR [ASCIZ/
?Zero length file !/]		;EVEN PARANOID PEOPLE HAVE ENEMIES
	jrst	erioin		;AND TRY AGAIN.
	subttl real time initialisation errors

; here when we can't get enough core.

CORER:	OUTSTR	[ASCIZ /?Can't get core/]
	jrst	erioin		; give back i/o channel and try again.

; here when we can't lock.

LOCKER:	OUTSTR	[ASCIZ /?Can't lock.
LOCK error code = /]
	MOVE	T1,SETUP	;GET ERROR CODE   ***** WHY NOT OMIT???
	PUSHJ	P,OCTOUT
;;;;;	exit	1,		; back to monitor on this one
	JRST SYSSET		; GO BACK TO 1ST PROMPT

ifn 0,<	OUTSTR	[ASCIZ/
Sleeping. Will try again a little later.
/]
RELOCK:	SKPINC			;IF USER TYPES, EXIT
	SKIPA
	jrst	[outstr [asciz /
[type CONTinue to keep trying/]
		EXIT	1,		;SO CONTINUE WILL.
		jrst relok1]
relok1:	MOVEI	SETUP,6
	SLEEP	SETUP,
> ; end ifn 0 above
	MOVE	SETUP,[XWD 1,1];TRY AGAIN
	LOCK	SETUP,
	 jrst	locker		;KEEP TRYING
	OUTSTR	[ASCIZ /[LOCKED]
/]
	JRST	LOCKED

TRPERR:	OUTSTR [ASCIZ /?Can't set up PI locations
/]
	jrst	sysset		; core down and give back i/o channel
	subttl dac and playing errors

; here when no next pointer. Dac has raised done flag but there are more
; samples to send.

SLOW:	OUTSTR	[ASCIZ /
?Could not read input fast enough?
/]
	jrst	popret		; pop off call and return.

; here when Dac raises data-missed flag. Someone has turned off the
; interrupt system or we spent too much time in a higher priority
; interrupt routine.

MISSED:	OUTSTR	[ASCIZ /
?Took too long to service interrupt.
/]
popret:	POP	P,(P)		;GET RID OF CALL
	JRST	X1

; here when Dac doesn't respond to being turned on,
; or it has turned itself off.

DEADAC:	OUTSTR	[ASCIZ /
?Dac is dead.
/]
	POP	P,(P)
	JRST	PANIC

; here if we hit EOT while reading mag-tape.

	ifon FTMT,<
EOTER:	OUTSTR [ASCIZ /
?Hit end of tape./]
	jrst	erioin		; give back i/o channel if we have one.
> ; END IFN FTMT ABOVE
	list
	subttl <ctrl c> processing and other panic stops

;HERE ON ↑C INTERRUPT

INTLOC:	PUSH	P,INTBLK+2	;WHERE ARE WE COMING FROM ?
	SETZM	INTBLK+2	;LET ↑C NEST
	AOSGE	CCINT
	POPJ	P,		;WE'VE BEEN HERE BEFORE.

	SKIPGE	DFLG		;IS DAC OFF?
	JRST	X1		;YUP. JUST UNLOCK ETC.

;HERE ON A PANIC STOP

PANIC:	DACOFF			; TURN OFF THE DAC
	SETOM	DFLG		;AND SET FLAG FOR OTHERS
	ifon FTKSYS,<
	SKIPL	KILFLG		;DO WE HAVE TO RESTORE THE SYSTEM?
	JRST	X1
	SETZM	TPOINT		;MAKE SURE THERE IS NO DATA READY
	MOVNI	T1,1		;FAKE THE END OF A BLKO.
	HRLM	T1,diowd
	CONO	PI,1B24!1B29	;FAKE AN INTERRUPT.
> ; END IFN FTKSYS ABOVE
	list
	JRST	X1
	SUBTTL	SUBROUTINES

;ROUTINE TO GET A CHARACTER INTO T1

INCHAD:
	ifoff ftfsub,<
	INCHWL	T1
	CAIN	T1,3		;↑C?
	 EXIT
> ; end ife ftfsub

	ifon ftfsub,<
	ildb	t1,spcadd	; get byte
> ; end ifn ftfsub above
	list
	CAIL	T1,141		;CHECK FOR LOWER CASE.
	CAILE	T1,172
	POPJ	P,
	TRZ	T1,40		;CONVERT TO UPPER CASE.
	POPJ	P,
	SUBTTL CLOCK SUBROUTINES

	ifon FT16B,<
; HERE TO SET CLOCK RATE FOR NEW DAC
; ON RETURN, T2 CONAINS CLOCK BITS, T1 CONTAINS SAMPLING RATE
; SKIP RETURN ON EXACT MATCH

NCLK:	MOVE	T1,[↑D1000000]	; 10 ↑ 6
	IDIV	T1,@SRATE	; CONVERT TO SAMPLING PERIOD IN MICRO SECS
	CAIG	T1,1
	 JRST	TF		; TOO HIGH A CLOCK RATE
	CAILE	T1,400
	 JRST	TS		; TOO LOW A CLOCK RATE
	JUMPE	T2,COK		; JUST RIGHT
	 JRST	NBDCLK
TF:	MOVEI	T1,2
	JRST	NBDCLK

TS:	MOVEI	T1,377
	JRST	NBDCLK

COK:	AOS	(P)
NBDCLK:	HRRZI	T2,-1(T1)	; GET CLOCK BITS
	MOVE	T3,[↑D1000000]
	IDIVM	T3,T1		; CONVERT BACK TO SAMPLING RATE
	POPJ	P,
> ; END IFN FT16B
	list
	ifon FT12B,<
; HERE TO SET CLOCK RATE FOR OLD DAC
; RETURN T2 CONTAINS CLOCK BITS, T1 CONAINS SAMPLING RATE
; SKIP RETURN ON EXACT MATCH

OCLK: 	MOVSI	T3,-NMCLK	;SET UP AOBJN POINTER.
CLKCHK:	HRRZ	T1,CLKTAB(T3)	;GET A VALID CLOCK RATE.
	CAMN	T1,@SRATE	;MATCH?
	 JRST	GOTCLK		;YUP.
	CAML	T1,@SRATE	;IS THIS THE "BEST".
	 JRST	DEFCLK		;USE IT FOR NOW.
	AOBJN	T3,CLKCHK	;TRY NEXT ENTRY
	SOJA	T3,DEFCLK	;POINT T3 TO LAST ENTRY

GOTCLK:	AOS	(P)		;GIVE GOOD RETURN
DEFCLK:	HLRZ	T2,CLKTAB(T3)	;GET CLOCK BITS.
	POPJ	P,		;RETURN

	DEFINE CLKRAT <

	DEFINE	X(CBITS,FREQ)
<	XWD	CBITS,↑D<FREQ>	>
	X	(2,4000)
	X	(12,5000)
	X	(3,6400)
	X	(4,8000)
	X	(14,10000)
	X	(5,12800)
	X	(6,16000)
	X	(16,20000)
	X	(25,25600)
	X	(7,32000)
	X	(17,40000)
	X	(27,64000)
	X	(37,80000)
>
CLKTAB:	CLKRAT

	NMCLK=.-CLKTAB
> ; END IFN FT12B
	list
	SUBTTL DAC SPECIFIC SUBROUTINES

	ifon FTMDAC,<
;HERE TO START THE DAC.

ODACON:	HRRZ	T1,CONOWD	; GET THE CONOWD
	TRO	T1,DONE!ON!DACPI; TURN ON GOOD BITS
	HRRM	T1,CONOWD	; RESET THE CONOWD
	XCT	CONOWD		; DO THE CONO.
	POPJ	P,

; HERE TO STOP THE OLD DAC

ODACOF:	DACIO	(CONO,OFF)	; CONO OFF THE DAC
	POPJ	P,

; HERE TO START THE NEW DAC

NDACON:	HRRZ	T1,CONOWD	; GET THE CONO
	TRO	T1,DONE!ON!DACPI; TURN ON GOOD BITS
	HRRM	T1,CONOWD
	XCT	CONOWD
	POPJ	P,

; HERE TO STOP THE NEW DAC

NDACOF:	DACIO	(CONO,OFF)	; TURN THE DAC OFF
	DACIO	(CONI,DACSTT)	; AND READ IN THE STATUS
	POPJ	P,
> ; END IFN FTMDAC
	list

;HERE TO COMPUTE THE LENGTH OF THE LAST TRANSFER

GLSTLN:	MOVE	T1,LIOWD
	ifon FTMT,<
	TLNN	F,.MTDEV	;IS IT MAG-TAPE?
	 JRST	GOTLST		;NOPE. DONE.
	MOVEI	T1,DSK		;YUP. HAVE TO DO MORE WORK.
	MTCHR.	T1,		;GET SOME DATA
	 POPJ	P,		;DIDN'T WORK.
	HLLZS	T1		;GET WORD COUNT.
	MOVNS	T1		;NEGATE IT.
	HRR	T1,LIOWD	;STICK IN THE LAST BUFFER ADDRESS.
> ; END IFN FTMT ABOVE
	list
GOTLST:	TLZ	T1,3		;MAKE IT MULTIPLE OF 4 WORDS.
	POPJ	P,		;DONE.

	ifon FTMT,<
;HERE TO BACKSPACE TAPE

BAKWRD:	TROE	F,.ATEOF	;SET THE "AT EOF" FLAG.
BAK1:	MTBSF.	DSK,		;BACKSPACE 1 FILE,
	MTWAT.	DSK,		;WAIT FOR IT.
	STATZ	DSK,IO.BOT	;BOT?
	 POPJ	P,		;YUP. GUESS WE CAN STOP NOW.
	AOJLE	T1,BAK1		;NOPE CONTINUE.
	MTSKF.	DSK,		;SKIP OVER LAST EOF MARK
	POPJ	P,		;RETURN
>	; END IFN FTMT ABOVE
	list
	DODAC			; GENERATE THE TABLE OF POINTERS TO I/O INST.

	ifoff ftfsub,<
	END	
> ; end ife ftfsub above
	ifon ftfsub,<
	end
> ; end ifn ftfsub above
	list